home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / qb2 / pro15 / p-demo2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-08-20  |  5.3 KB  |  292 lines
  1. {
  2.  *****************************************************************************
  3.  * P-DEMO2 - Palette demo.                             *
  4.  *                                         *
  5.  * Written for GRAFIX by:  Joseph A. Albrecht                     *
  6.  *                                         *
  7.  * Press F10 to toggle between 320 and 640 graphic modes             *
  8.  * Press ESC to exit program                             *
  9.  *****************************************************************************
  10. }
  11.  
  12. PROGRAM PaletteDemo2;
  13.  
  14. USES
  15.   Crt,
  16.   Grafix;
  17.  
  18. TYPE
  19.   PaletteArray = ARRAY[0..15] OF WORD;
  20.  
  21. CONST
  22.    H0: PaletteArray = (00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00);
  23.    H1: PaletteArray = (00,01,08,08,08,07,03,08,00,00,00,00,00,00,00,00);
  24.    H2: PaletteArray = (00,01,08,08,06,10,03,08,00,00,00,00,00,00,00,00);
  25.    H3: PaletteArray = (00,01,08,08,10,03,03,08,00,00,00,00,00,00,00,00);
  26.    H4: PaletteArray = (00,01,06,14,06,10,03,04,00,00,00,00,00,00,00,00);
  27.    H5: PaletteArray = (00,01,14,06,10,03,04,14,00,00,00,00,00,00,00,00);
  28.    H6: PaletteArray = (00,01,06,14,06,10,14,14,00,00,00,00,00,00,00,00);
  29.    H7: PaletteArray = (00,01,14,06,10,03,04,14,00,00,00,00,00,00,00,00);
  30.    H8: PaletteArray = (00,01,06,14,06,10,03,04,03,00,00,14,00,00,00,00);
  31.    H9: PaletteArray = (00,01,14,06,10,03,04,14,00,09,00,00,06,00,00,00);
  32.    H10: PaletteArray = (00,01,06,14,06,10,14,14,00,00,01,00,00,04,00,00);
  33.    H11: PaletteArray = (00,01,14,06,10,03,04,14,00,10,00,00,00,00,05,00);
  34.    H12: PaletteArray = (00,01,06,14,06,10,03,04,03,00,00,00,00,00,00,09);
  35.  
  36. VAR
  37.   Image: ARRAY[0..16006] OF WORD;
  38.   C1: ARRAY[1..2] OF INTEGER;
  39.   C2: ARRAY[1..3] OF INTEGER;
  40.   J, L, N, T, X, Y, Z, S1, NoTimes, Times, Graphics: INTEGER;
  41.   Tandy11: BOOLEAN;
  42.  
  43. PROCEDURE CheckKey;
  44.  
  45. VAR
  46.   Ch: CHAR;
  47.  
  48. BEGIN
  49.  
  50.   Ch := #255;
  51.   IF KeyPressed THEN
  52.     Ch := ReadKey;
  53.   IF Ch = #27 THEN
  54.     BEGIN
  55.       AudioOff;
  56.       ExitGraphics;
  57.       Halt(0);
  58.     END;
  59.   IF Ch = #00 THEN
  60.     BEGIN
  61.       Ch := ReadKey;
  62.       IF (Ch = #68) AND (Tandy11 = True) THEN
  63.     BEGIN
  64.       IF Graphics = 320 THEN
  65.         BEGIN
  66.           Graphics := 640;
  67.           HighGraphics;
  68.           PaletteUsing(H0[0]);
  69.           ExtPut(0, 0, Image[0], PutXor);
  70.           ExtPut(320, 0, Image[0], PutXor);
  71.         END
  72.       ELSE
  73.         BEGIN
  74.           Graphics := 320;
  75.           MediumGraphics;
  76.           PaletteUsing(H0[0]);
  77.           ExtPut(0, 0, Image[0], PutXor);
  78.         END;
  79.     END;
  80.     END;
  81.  
  82. END;
  83.  
  84. PROCEDURE MakeNoise;
  85.  
  86. BEGIN
  87.  
  88.  Noise(5, 8, 12);
  89.  CheckKey;
  90.  
  91. END;
  92.  
  93. PROCEDURE GetZ;
  94.  
  95. BEGIN
  96.  
  97.   Z := Random(3) + 1;
  98.   Pause(2);
  99.   CheckKey;
  100.  
  101. END;
  102.  
  103. PROCEDURE GenerateSound;
  104.  
  105. BEGIN
  106.  
  107.  ExtSound(S1, 10, 7, 0);
  108.  ExtSound(S1 + 5, 10, 7, 1);
  109.  ExtSound(S1 + 10, 10, 7, 2);
  110.  Inc(S1, 5);
  111.  CheckKey;
  112.  
  113. END;
  114.  
  115. PROCEDURE LightCoils1;
  116.  
  117. BEGIN
  118.  
  119.   PaletteUsing(H2[0]);
  120.   Pause(3);
  121.   CheckKey;
  122.  
  123. END;
  124.  
  125. PROCEDURE LightCoils2;
  126.  
  127. BEGIN
  128.  
  129.   PaletteUsing(H3[0]);
  130.   Pause(3);
  131.   CheckKey;
  132.  
  133. END;
  134.  
  135. PROCEDURE LightPosts;
  136.  
  137. BEGIN
  138.  
  139.   SetPalette(Green, Brown);
  140.   SetPalette(Cyan, Yellow);
  141.   J := 1;
  142.   FOR T := 1 TO 2 DO
  143.     BEGIN
  144.       Y := 193;
  145.       WHILE Y >= 58 DO
  146.     BEGIN
  147.       X := 42;
  148.       WHILE X <= 278 DO
  149.         BEGIN
  150.           ExtPaint(X, Y, C1[J], Blue);
  151.           IF Graphics = 640 THEN
  152.         ExtPaint(X + 320, Y, C1[J], Blue);
  153.           Inc(X, 236);
  154.         END;
  155.       Dec(Y, 14);
  156.     END;
  157.       GenerateSound;
  158.       SetPlotColor(C1[J]);
  159.       ExtLine(68, 42, 72, 42);
  160.       ExtLine(250, 42, 253, 42);
  161.       IF Graphics = 640 THEN
  162.     BEGIN
  163.       ExtLine(388, 42, 392, 42);
  164.       ExtLine(570, 42, 573, 42);
  165.     END;
  166.       J := (J Mod 2) + 1;
  167.     END;
  168.   CheckKey;
  169.  
  170. END;
  171.  
  172. PROCEDURE LightGlobes;
  173.  
  174. BEGIN
  175.  
  176.   PaletteUsing(H4[0]);
  177.   Pause(3);
  178.   PaletteUsing(H5[0]);
  179.   Pause(3);
  180.   GenerateSound;
  181.   PaletteUsing(H6[0]);
  182.   Pause(3);
  183.   PaletteUsing(H7[0]);
  184.   Pause(3);
  185.   GenerateSound;
  186.   CheckKey;
  187.  
  188. END;
  189.  
  190. PROCEDURE LightArcs;
  191.  
  192. BEGIN
  193.  
  194.   MakeNoise;
  195.   PaletteUsing(H4[0]);
  196.   GetZ;
  197.   SetPalette(DarkGray, C2[Z]);
  198.   PaletteUsing(H5[0]);
  199.   GetZ;
  200.   SetPalette(LightBlue, C2[Z]);
  201.   PaletteUsing(H6[0]);
  202.   GetZ;
  203.   SetPalette(LightGreen, C2[Z]);
  204.   PaletteUsing(H7[0]);
  205.   GetZ;
  206.   SetPalette(LightBlue, C2[Z]);
  207.   CheckKey;
  208.  
  209. END;
  210.  
  211. PROCEDURE LightEmAll;
  212.  
  213. BEGIN
  214.  
  215.   FOR T := 1 TO 5 DO
  216.     BEGIN
  217.       Noise(5, L, 18);
  218.       PaletteUsing(H8[0]);
  219.       Pause(3);
  220.       PaletteUsing(H9[0]);
  221.       Pause(3);
  222.       PaletteUsing(H10[0]);
  223.       Pause(3);
  224.       PaletteUsing(H11[0]);
  225.       Pause(3);
  226.       PaletteUsing(H12[0]);
  227.       Pause(3);
  228.       Inc(L, 1);
  229.       CheckKey;
  230.     END;
  231.  
  232. END;
  233.  
  234. {Mainline}
  235. BEGIN
  236.  
  237.   Graphics := 320;
  238.   C1[1] := Green;
  239.   C1[2] := Cyan;
  240.   C2[1] := Blue;
  241.   C2[2] := Cyan;
  242.   C2[3] := Yellow;
  243.   GetTandy11(Tandy11);
  244.   BLoad('P-DEMO2.BIN', Image[0]);
  245.   MediumGraphics;
  246.   Randomize;
  247.   AudioOff;
  248.   SpeakerOn;
  249.   PaletteUsing(H0[0]);
  250.   ExtPut(0, 0, Image[0], PutXor);
  251.   IF Graphics = 640 THEN
  252.     ExtPut(320, 0, Image[0], PutXor);
  253.  
  254. {MainLoop}
  255.   WHILE True DO
  256.     BEGIN
  257.       S1 := 120;
  258.       FOR N := 1 TO 7 DO
  259.     BEGIN
  260.       LightCoils1;
  261.       GenerateSound;
  262.       LightCoils2;
  263.       GenerateSound;
  264.     END;
  265.       FOR N := 1 TO 7 DO
  266.     BEGIN
  267.       LightPosts;
  268.       LightCoils1;
  269.       LightCoils2;
  270.       GenerateSound;
  271.     END;
  272.       FOR N := 1 TO 4 DO
  273.     LightGlobes;
  274.       FOR N := 1 TO 5 DO
  275.     BEGIN
  276.       LightArcs;
  277.       GenerateSound;
  278.     END;
  279.       Randomize;
  280.       Times := 0;
  281.       NoTimes := Random(7) + 1;
  282.       WHILE Times < NoTimes DO
  283.     BEGIN
  284.       L := 6;
  285.       LightEmAll;
  286.       Inc(Times);
  287.     END;
  288.     END;
  289.  
  290. END.
  291.  
  292.